perm filename PIX.SAI[PIX,HPM]1 blob
sn#011189 filedate 1972-11-12 generic text, type T, neo UTF8
01200 BEGIN "PIX"
01300
01400 REQUIRE "HELIB[1,3]" LIBRARY;
01500 REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
01600 REQUIRE "SOBMAT[SYS,HE]" LOAD_MODULE;
01700 REQUIRE 2000 STRING_SPACE;
01800 REQUIRE "⊂⊃||" DELIMITERS;
01900
02000 DEFINE α=⊂COMMENT⊃, EXT=⊂EXTERNAL⊃, INT=⊂INTEGER⊃, PRO=⊂PROCEDURE⊃,
02100 CRLF=⊂'15&'12⊃, BHEAD(BUF)=⊂(BUF+1) LAND '777777⊃, REF=⊂REFERENCE⊃,
02200 RED=⊂2⊃, BLUE=⊂3⊃, GREEN=⊂4⊃, CLEAR=⊂1⊃, XDATA=⊂3⊃;
02300 EXT PRO PICINI(INT CHAN, FILE, EXTEN, PPN;REF BOOLEAN FAIL;INT ARRAY STOR);
02400 EXT PRO PICRD(REF BOOLEAN FAIL; INT ARRAY STOR);
02500 EXT PRO PICWR(INT CHAN, FILE, EXTEN, PPN; REF BOOLEAN FAIL; INT ARRAY STOR);
02600 EXT PRO RELCOR(INT IOWD);
02700 EXT INT PRO GETCOR(INT SIZE);
02800 EXT BOOLEAN PRO VIDEO(INT EXP, X,Y);
02900 EXT PRO INP;
03000 EXT INT PRO GIOWD(INT ARRAY BUF);
03100 EXT PRO EYECAL(INT SIZE, FRAM, FLAG; INT ARRAY BUF);
03200 EXT PRO CWHEEL(INT CODE);
03300 EXT PRO TVIN;
03400 EXT PRO PRDUMP;
03500 EXT PRO PORTR;
03600 FORTRAN REAL PROCEDURE SIN;
03700 FORTRAN REAL PROCEDURE COS;
03800 FORTRAN REAL PROCEDURE SQRT(REAL X);
03900 EXTERNAL PROCEDURE SPWON(INTEGER TIC;REFERENCE INTEGER ADDR);
04000 EXTERNAL PROCEDURE CALLEN;
04100 EXTERNAL PROCEDURE SPWOFF;
04200 EXT PROCEDURE INVRT(REAL ARRAY A,AI);
04300
04400 EXT INT TVWORD, FLINE, LLINE, RSIDE, LSIDE, TCLIP, BCLIP, PRTBUF,
04500 L1, L2, L3, P1,P2,P3,STATUS,TSERVO,LENS,TVCAM;
04600
04700 SAFE INT ARRAY PNTRS[1:25], DPYBUF[1:600], CLIPS[1:4,1:3];
04800 SAFE REAL ARRAY CAMERA_MODEL[1:10,1:3],PPOT0,PPOTD,TPOT0,TPOTD,FPOT0,FPOTD,
04900 MART,SWING,FOC,FOCLEN0,FOCLENG[1:4],DP,P0[1:4,1:3],PP[1:4,1:2];
05000 INT I, EXP, ANS, FSAV, LLSAV, RSAV, LSAV, TVLENG, PICNUM, CAMERR;
05100 REAL PANPOT, FOCPOT, TILPOT;
05200 LABEL LOOP, SKIP, SKIP1;
05300 BOOLEAN SENSSET, TVREAD;
05400 STRING STR, TITLE, DESCRIPT;
05500 SAFE INTEGER ARRAY PICALLOC[1:25]; α allocation table for data blocks;
05600 PRELOAD_WITH 3,0,1,2;
05700 SAFE INT ARRAY COLNUM[1:4];
05800 α first we initialize the world;
05900 CALL('15,"VDSMAP");
06000 TVCAM ← 3;
06100 TCLIP ← 0;
06200 BCLIP ← 7;
06300 SENSSET ← EXP ← FALSE;
06400 CLIPS[1,1] ← -1;
06500 ARRBLT(CLIPS[1,2],CLIPS[1,1],11);
06600 PICALLOC[1] ← PNTRS[1] ← 0;
06700 ARRBLT(PICALLOC[2],PICALLOC[1],24);
06800 ARRBLT(PNTRS[2],PNTRS[1],24);
06900 LOOP: BEGIN "TVIN"
07000 BEGIN INTEGER ARRAY BUF[1:10000];
07100 TVWORD ← GIOWD(BUF);
07200 FLINE←'13;
07300 LLINE←'373;
07400 RSIDE←'512;
07500 LSIDE←'13;
07600 FSAV ← FLINE;
07700 LLSAV ← LLINE;
07800 RSAV ← RSIDE;
07900 LSAV ← LSIDE;
08000 END;
08100 TVLENG ← ((RSIDE-LSIDE)/9+1)*(LLINE-FLINE+1);
08200 DESCRIPT ← TITLE ←NULL;
08300 PICALLOC[CLEAR] ← GETCOR(TVLENG);
08400 SKIP1: FOR I←1 STEP 1 UNTIL 4 DO IF CLIPS[I,1]<0 THEN
08500 BEGIN CLIPS[I,1] ← BCLIP; CLIPS[I,2] ← TCLIP;END;
08600 α and, finally, take the picture;
08700
08800 FLINE ← FSAV;
08900 LLINE ← LLSAV;
09000 RSIDE ← RSAV;
09100 LSIDE ← LSAV;
09200 FOR I←1 STEP 1 UNTIL 4 DO IF PICALLOC[I] THEN
09300 BEGIN "TAKE" INTEGER N;
09400 TVWORD ← PICALLOC[I];
09500 BCLIP ← CLIPS[I,1];
09600 TCLIP ← CLIPS[I,2];
09700 INCHRW;
09800 TVIN;
09900 END "TAKE";
10000 END "TVIN";
10100 BEGIN "DSKOUT"
10200 INTEGER FILE, PPN, EXTEN, FAIL;
10300 LABEL LOOP3;
10400 FOR I←1 STEP 1 UNTIL 25 DO PNTRS[I]←
10500 IF PICALLOC[I] THEN PICALLOC[I]+1 ELSE 0;
10600 LOOP3: OUTSTR("FILE NAME=");
10700 FILE ← CVFIL(STR←INCHWL,EXTEN,PPN);
10800 IF LENGTH(STR)≠0 THEN
10900 BEGIN
11000 PICWR(1,FILE,EXTEN,PPN,FAIL,PNTRS);
11100 IF FAIL THEN BEGIN USERERR(0,0,"WRITING OF FILE "&STR&" FAILED"); GO TO LOOP3;END;
11200 OUTSTR("FILE "&STR&" WRITTEN OUT"&CRLF);
11300 END;
11400 END "DSKOUT";
11500 α return for next picture;
11600
11700 FOR I←1 STEP 1 UNTIL 25 DO
11800 BEGIN
11900 IF PICALLOC[I] THEN RELCOR(PICALLOC[I]);
12000 PICALLOC[I] ← PNTRS[I] ← 0;
12100 END;
12200 GO TO LOOP;
12300 END;